--- /dev/null
--- /dev/null
++From ebef68ace092718a1691a7f1dfcb280f39719c5d Mon Sep 17 00:00:00 2001
++From: Glenn Morris <rgm@gnu.org>
++Date: Mon, 5 May 2014 20:53:31 -0700
++Subject: Security issues in find-gc.el have been fixed (CVE-2014-3422)
++
++Applied upstream patch to fix
++https://security-tracker.debian.org/tracker/CVE-2014-3422
++
++ find-gc.el misc fixes
++
++ The whole file looks obsolete and/or broken.
++
++ * lisp/emacs-lisp/find-gc.el (find-gc-source-directory): Give it a value.
++ (find-gc-source-files): Update some names.
++ (trace-call-tree): Simplify and update. Avoid predictable temp-file names.
++
++Origin: upstream, commit: r117067, 0f5506668b178c355a6e9012469984c75c1797aa
++Added-by: Rob Browning <rlb@defaultvalue.org>
++Bug: https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=748140
++---
++ lisp/ChangeLog | 7 ++++
++ lisp/emacs-lisp/find-gc.el | 80 +++++++++++++++++++++-------------------------
++ 2 files changed, 43 insertions(+), 44 deletions(-)
++
++diff --git a/lisp/ChangeLog b/lisp/ChangeLog
++index 8cd322a..08548e7 100644
++--- a/lisp/ChangeLog
+++++ b/lisp/ChangeLog
++@@ -1,3 +1,10 @@
+++2014-05-06 Glenn Morris <rgm@gnu.org>
+++
+++ * emacs-lisp/find-gc.el (find-gc-source-directory): Give it a value.
+++ (find-gc-source-files): Update some names.
+++ (trace-call-tree): Simplify and update.
+++ Avoid predictable temp-file names. (http://bugs.debian.org/747100)
+++
++ 2013-03-11 Glenn Morris <rgm@gnu.org>
++
++ * Version 24.3 released.
++diff --git a/lisp/emacs-lisp/find-gc.el b/lisp/emacs-lisp/find-gc.el
++index 82b3e94..52a9703 100644
++--- a/lisp/emacs-lisp/find-gc.el
+++++ b/lisp/emacs-lisp/find-gc.el
++@@ -23,14 +23,15 @@
++
++ ;; Produce in find-gc-unsafe-list the set of all functions that may invoke GC.
++ ;; This expects the Emacs sources to live in find-gc-source-directory.
++-;; It creates a temporary working directory /tmp/esrc.
++
++ ;;; Code:
++
++ (defvar find-gc-unsafe-list nil
++ "The list of unsafe functions is placed here by `find-gc-unsafe'.")
++
++-(defvar find-gc-source-directory)
+++(defvar find-gc-source-directory
+++ (file-name-as-directory (expand-file-name "src" source-directory))
+++ "Directory containing Emacs C sources.")
++
++ (defvar find-gc-subrs-callers nil
++ "Alist of users of subrs, from GC testing.
++@@ -59,14 +60,14 @@ Each entry has the form (FUNCTION . FUNCTIONS-IT-CALLS).")
++ "indent.c" "search.c" "regex.c" "undo.c"
++ "alloc.c" "data.c" "doc.c" "editfns.c"
++ "callint.c" "eval.c" "fns.c" "print.c" "lread.c"
++- "abbrev.c" "syntax.c" "unexcoff.c"
+++ "syntax.c" "unexcoff.c"
++ "bytecode.c" "process.c" "callproc.c" "doprnt.c"
++- "x11term.c" "x11fns.c"))
+++ "xterm.c" "xfns.c"))
++
++
++ (defun find-gc-unsafe ()
++ "Return a list of unsafe functions--that is, which can call GC.
++-Also store it in `find-gc-unsafe'."
+++Also store it in `find-gc-unsafe-list'."
++ (trace-call-tree nil)
++ (trace-use-tree)
++ (find-unsafe-funcs 'Fgarbage_collect)
++@@ -102,47 +103,38 @@ Also store it in `find-gc-unsafe'."
++
++
++
++-(defun trace-call-tree (&optional already-setup)
+++(defun trace-call-tree (&optional ignored)
++ (message "Setting up directories...")
++- (or already-setup
++- (progn
++- ;; Gee, wouldn't a built-in "system" function be handy here.
++- (call-process "csh" nil nil nil "-c" "rm -rf /tmp/esrc")
++- (call-process "csh" nil nil nil "-c" "mkdir /tmp/esrc")
++- (call-process "csh" nil nil nil "-c"
++- (format "ln -s %s/*.[ch] /tmp/esrc"
++- find-gc-source-directory))))
++- (with-current-buffer (get-buffer-create "*Trace Call Tree*")
++- (setq find-gc-subrs-called nil)
++- (let ((case-fold-search nil)
++- (files find-gc-source-files)
++- name entry)
++- (while files
++- (message "Compiling %s..." (car files))
++- (call-process "csh" nil nil nil "-c"
++- (format "gcc -dr -c /tmp/esrc/%s -o /dev/null"
++- (car files)))
++- (erase-buffer)
++- (insert-file-contents (concat "/tmp/esrc/" (car files) ".rtl"))
++- (while (re-search-forward ";; Function \\|(call_insn " nil t)
++- (if (= (char-after (- (point) 3)) ?o)
++- (progn
++- (looking-at "[a-zA-Z0-9_]+")
++- (setq name (intern (buffer-substring (match-beginning 0)
++- (match-end 0))))
++- (message "%s : %s" (car files) name)
++- (setq entry (list name)
++- find-gc-subrs-called (cons entry find-gc-subrs-called)))
++- (if (looking-at ".*\n?.*\"\\([A-Za-z0-9_]+\\)\"")
+++ (setq find-gc-subrs-called nil)
+++ (let ((case-fold-search nil)
+++ (default-directory find-gc-source-directory)
+++ (files find-gc-source-files)
+++ name entry rtlfile)
+++ (dolist (file files)
+++ (message "Compiling %s..." file)
+++ (call-process "gcc" nil nil nil "-I" "." "-I" "../lib"
+++ "-fdump-rtl-expand" "-o" null-device "-c" file)
+++ (setq rtlfile
+++ (file-expand-wildcards (format "%s.*.expand" file) t))
+++ (if (/= 1 (length rtlfile))
+++ (message "Error compiling `%s'?" file)
+++ (with-temp-buffer
+++ (insert-file-contents (setq rtlfile (car rtlfile)))
+++ (delete-file rtlfile)
+++ (while (re-search-forward ";; Function \\|(call_insn " nil t)
+++ (if (= (char-after (- (point) 3)) ?o)
++ (progn
++- (setq name (intern (buffer-substring (match-beginning 1)
++- (match-end 1))))
++- (or (memq name (cdr entry))
++- (setcdr entry (cons name (cdr entry))))))))
++- (delete-file (concat "/tmp/esrc/" (car files) ".rtl"))
++- (setq files (cdr files)))))
++-)
++-
+++ (looking-at "[a-zA-Z0-9_]+")
+++ (setq name (intern (match-string 0)))
+++ (message "%s : %s" (car files) name)
+++ (setq entry (list name)
+++ find-gc-subrs-called
+++ (cons entry find-gc-subrs-called)))
+++ (if (looking-at ".*\n?.*\"\\([A-Za-z0-9_]+\\)\"")
+++ (progn
+++ (setq name (intern (match-string 1)))
+++ (or (memq name (cdr entry))
+++ (setcdr entry (cons name (cdr entry)))))))))))))
++
++ (defun trace-use-tree ()
++ (setq find-gc-subrs-callers (mapcar 'list (mapcar 'car find-gc-subrs-called)))
projects / emacs.git / commitdiff